home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
program
/
tcqbsnip.zip
/
QIMCV.BAS
< prev
next >
Wrap
BASIC Source File
|
1997-05-11
|
7KB
|
247 lines
DECLARE SUB MakeProg ()
DECLARE SUB BMPLoad ()
DECLARE SUB PCXLoad ()
DECLARE SUB TGALoad ()
DECLARE SUB Menu ()
DEFINT A-Z
' QIMCV.BAS
' Quick Image Converter 1.0
' by Tika Carr
' May 4, 1997
'
' Freeware:
'
' This program can be used as you please, as long as you give credit to
' the respective author(s).
'
' No warranties or guarantees are expressed or implied.
'
' Credits:
'
' Tika Carr (t.carr@juno.com) Put together the pieces :)
' Dave Shea BMP Decoder
' Jonathan Leger (leger@mail.dtx.net) PCX Decoder
' Erika Schulze (100775.2275@compuserve.com) TGA Decoder
' Earl Montgomery Load/Save QIM format
'
' Special thanks to others in the FidoNet QUIK_BAS Echo who helped
' contribute ideas to this project.
'
' Description:
'
' Quick Image Converter will convert 256 color 320 x 200 images saved in
' BMP, PCX or TGA format (sorry, no GIF due to licensing requirements).
' TGA images must be saved in uncompressed format. The result is a
' .QIM file, that can be quickly BLOADed into your programs:
'
' Block 1: QuickBasic BLOADable Image (64006 bytes)
' Block 2: Palette information (768 bytes)
' Total: Total File Size (64774)
'
' This program also saves a .BAS file that you can merge into your programs
' and display the QIM file.
'
' Revision History:
'
' 1.0 5/4/1997 Put together different sources, and created
' main and sub menus.
'**** Startup ****
TYPE tga
info AS STRING * 1
clr AS STRING * 1
img AS STRING * 1
orig AS INTEGER
col AS INTEGER
bits AS STRING * 1
xval AS INTEGER
yval AS INTEGER
w AS INTEGER
h AS INTEGER
pix AS STRING * 1
desc AS STRING * 1
END TYPE
'**** Main Program ****
SCREEN 0, 0, 0: WIDTH 80: COLOR 15, 1: CLS
PRINT TAB(25); CHR$(219) + CHR$(178) + CHR$(177) + CHR$(176);
PRINT " Quick Image Converter ";
PRINT CHR$(176) + CHR$(177) + CHR$(178) + CHR$(219)
PRINT TAB(34); "by Tika Carr"
LOCATE 7
PRINT TAB(25); "[L] Load an Image"
PRINT TAB(25); "[D] Get a Directory Listing"
PRINT TAB(25); "[Q] Quit Program"
PRINT : PRINT : COLOR 10
PRINT TAB(25); "While viewing picture:"
PRINT
PRINT TAB(25); "[S] Save screen"
PRINT TAB(25); "[E] Exit to main menu without saving"
PRINT TAB(25); "[Q] Quit program without saving"
DO: P$ = LCASE$(INPUT$(1)): LOOP WHILE INSTR("ldqv", P$) = 0
IF P$ = "q" THEN COLOR 7, 0: CLS : END
IF P$ = "d" THEN COLOR 7, 0: CLS : SHELL "dir /w /p": SLEEP: RUN
COLOR 11: LOCATE 23, 3
WHILE format$ <> "bmp" AND format$ <> "tga" AND format$ <> "pcx"
PRINT "File to load (MUST give BMP, PCX or TGA ext) ENTER = Menu: ";
LINE INPUT file$
IF file$ = "" THEN RUN
IF LEN(file$) > 4 THEN format$ = LCASE$(RIGHT$(file$, 3))
WEND
LOCATE 23, 3: PRINT SPACE$(70); : LOCATE 23, 3
PRINT "Image Filename (no ext): "; : LINE INPUT img$
LOCATE 23, 3: PRINT SPACE$(70); : LOCATE 23, 3
PRINT "BASIC Program Name (no ext) or ENTER for same as Image: ";
LINE INPUT BAS$
IF BAS$ = "" THEN BAS$ = img$ + ".BAS" ELSE BAS$ = BAS$ + ".BAS"
img$ = img$ + ".QIM"
SCREEN 13
'**** Load A BMP Image
IF format$ = "bmp" THEN
LOCATE 10, 5: PRINT "Please wait for image to load."
SLEEP 2: CLS
OPEN file$ FOR BINARY AS #1
h$ = SPACE$(14): s$ = SPACE$(4)
GET #1, 1, h$: GET #1, 15, s$: bz = CVI(s$)
IF bz = 12 THEN
P$ = SPACE$(768)
ELSEIF bz = 40 THEN P$ = SPACE$(1024)
ELSE SCREEN 0, 0, 0: WIDTH 80: CLS : PRINT "Unable to load BMP image.": END
END IF
i$ = SPACE$(bz): GET #1, 15, i$: nb = CVI(MID$(i$, 15, 4))
IF nb <> 8 THEN END
GET #1, bz + 15, P$
IF bz = 40 THEN ng = 4 ELSE ng = 3
FOR x = 1 TO LEN(P$) STEP ng
b# = INT((ASC(MID$(P$, x, 1))) / 4)
g# = INT((ASC(MID$(P$, x + 1, 1))) / 4)
r# = INT((ASC(MID$(P$, x + 2, 1))) / 4)
c# = b# * 65536# + g# * 256# + r#: PALETTE ((x - 1) / ng), c#
NEXT
y = 199: d$ = " "
WHILE y >= 0
x = 0: WHILE x < 320: GET 1, , d$: PSET (x, y), ASC(d$): x = x + 1: WEND
y = y - 1
WEND
CLOSE #1
END IF
'**** Load a PCX Image
IF format$ = "pcx" THEN
DIM q AS STRING * 768, ver AS STRING * 1
OPEN file$ FOR BINARY AS #1
GET #1, 2, ver
IF ASC(ver) <> 5 THEN
SCREEN 0, 0, 0, 0: WIDTH 80: CLS
PRINT "Unable to load PCX Image"
END
END IF
GET #1, LOF(1) - 767, q
FOR i = 1 TO 768 STEP 3: OUT &H3C8, P
r = INT(ASC(MID$(q, i, 1)) / 4): OUT &H3C9, r
g = INT(ASC(MID$(q, i + 1, 1)) / 4): OUT &H3C9, g
b = INT(ASC(MID$(q, i + 2, 1)) / 4): OUT &H3C9, b
P = P + 1
NEXT
SEEK #1, 129
ds = 2000: dat$ = INPUT$(ds, 1): dc = 1
FOR half = 1 TO 2
DEF SEG = &HA000 + ofs
FOR c = 0 TO 31999
IF dc > ds THEN dat$ = INPUT$(ds, 1): dc = 1
cl = ASC(MID$(dat$, dc, 1))
dc = dc + 1
IF dc > ds THEN : dat$ = INPUT$(ds, 1): dc = 1
IF cl > 192 THEN
LPS = cl - 192: cl = ASC(MID$(dat$, dc, 1)): dc = dc + 1
FOR L = LPS TO 1 STEP -1: POKE c, cl: c = c + 1: NEXT: c = c - 1
ELSE POKE c, cl
END IF
NEXT
ofs = ofs + &H7D0
NEXT
DEF SEG
CLOSE #1
END IF
'**** Load a TGA Image
IF format$ = "tga" THEN
DIM hdr AS tga
OPEN file$ FOR BINARY AS #1: GET #1, 1, hdr: CLOSE #1
OPEN file$ FOR BINARY AS #1
IF ASC(hdr.clr) <> 1 OR ASC(hdr.img) <> 1 THEN
SCREEN 0, 0, 0, 0: WIDTH 80: CLS
PRINT "Unable to load TGA file."
END
END IF
dcl = hdr.col * ASC(hdr.bits) / 8: dcs& = 19 + ASC(hdr.info)
dce& = dcs& + dcl%
SEEK #1, dcs&
FOR reg = 0 TO 255
t$ = SPACE$(3): GET #1, , t$
r = ASC(MID$(t$, 3)) \ 4: g = ASC(MID$(t$, 2)) \ 4
b = ASC(MID$(t$, 1)) \ 4
OUT &H3C8, reg: OUT &H3C9, r: OUT &H3C9, g: OUT &H3C9, b
NEXT
SEEK #1, dce&: t$ = SPACE$(1)
FOR y = 0 TO hdr.h - 1: FOR x = 0 TO hdr.w - 1
GET #1, , t$: col = ASC(t$): PSET (x, y), col
NEXT x, y
CLOSE #1
END IF
'**** Save Image (or Exit to menu or quit) ****'
DO
QI$ = LCASE$(INPUT$(1))
'**** Save to .QIM File Format ****
IF QI$ = "s" THEN 'Save Screen & palette
DEF SEG = &HA000 + 4000
OUT &H3C7, 0
FOR x = 0 TO 767: cv = INP(&H3C9): POKE x, cv: NEXT
DEF SEG = &HA000
BSAVE img$, 0, 63999 + 768
'**** Save a .BAS file loader
OPEN BAS$ FOR OUTPUT AS #1
PRINT #1, "' Loader for " + img$
PRINT #1, "' by Earl Montgomery"
PRINT #1, ""
PRINT #1, "DEFINT A-Z"
PRINT #1, ""
PRINT #1, "SCREEN 13"
PRINT #1, "OUT &H3C8, 0"
PRINT #1, "FOR x = 0 TO 767: OUT &H3C9, 0: NEXT"
PRINT #1, "DEF SEG = &HA000"
PRINT #1, "BLOAD " + CHR$(34) + img$ + CHR$(34) + ", 0"
PRINT #1, "DEF SEG = &HA000 + 4000"
PRINT #1, "OUT &H3C8, 0"
PRINT #1, "FOR x = 0 TO 767: P = PEEK(x): OUT &H3C9, P: NEXT"
PRINT #1, ""
PRINT #1, "SLEEP"
PRINT #1, "SCREEN 0, 0, 0, 0: WIDTH 80: COLOR 7,0: CLS: END"
CLOSE #1
END IF
IF QI$ = "q" THEN 'Exit program without saving
SCREEN 0, 0, 0, 0: WIDTH 80: CLS : END
END IF
RUN
LOOP WHILE INSTR("seq", QI$) = 0